Monster Media 1994 #2/Monster Media No. 2 (Monster Media)(1994).ISO/prog_bas/mquery.zip/MDYNAST.FRM

Text File | 1994-05-24 | 26KB | 1,037 lines

VERSION 2.00
Begin Form fDynaset
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   3750
   ClientLeft      =   1410
   ClientTop       =   2415
   ClientWidth     =   5655
   ClipControls    =   0   'False
   Height          =   4155
   Icon            =   MDYNAST.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   1350
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   3733.906
   ScaleMode       =   0  'User
   ScaleWidth      =   5675.317
   Tag             =   "Dynaset"
   Top             =   2070
   Width           =   5775
   Begin PictureBox FieldHeader
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   240
      Left            =   0
      ScaleHeight     =   240
      ScaleMode       =   0  'User
      ScaleWidth      =   5028
      TabIndex        =   15
      Top             =   480
      Width           =   5025
      Begin Label FieldHdrLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Field Name:"
         Height          =   252
         Left            =   120
         TabIndex        =   16
         Top             =   0
         Width           =   1212
      End
   End
   Begin PictureBox ViewButtons
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      ScaleHeight     =   495
      ScaleMode       =   0  'User
      ScaleWidth      =   5658.376
      TabIndex        =   0
      Top             =   0
      Width           =   5655
      Begin CommandButton SortButton
         Caption         =   "&Sort"
         Height          =   330
         Left            =   3128
         TabIndex        =   17
         Top             =   0
         Width           =   650
      End
      Begin CommandButton FilterButton
         Caption         =   "F&ilter"
         Height          =   330
         Left            =   2520
         TabIndex        =   22
         Top             =   0
         Width           =   650
      End
      Begin CommandButton CloseButton
         Cancel          =   -1  'True
         Caption         =   "&Close"
         Height          =   330
         Left            =   3780
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   0
         Width           =   650
      End
      Begin CommandButton DelButton
         Caption         =   "&Del"
         Height          =   330
         Left            =   1260
         TabIndex        =   4
         Top             =   0
         Width           =   650
      End
      Begin CommandButton EditButton
         Caption         =   "&Edit"
         Height          =   330
         Left            =   630
         TabIndex        =   3
         Top             =   0
         Width           =   650
      End
      Begin CommandButton AddButton
         Caption         =   "&Add"
         Height          =   330
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Width           =   650
      End
      Begin CommandButton FindButton
         Caption         =   "&Find"
         Height          =   330
         Left            =   1890
         TabIndex        =   1
         Top             =   0
         Width           =   650
      End
   End
   Begin PictureBox ChangeButtons
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   480
      Left            =   0
      ScaleHeight     =   480
      ScaleMode       =   0  'User
      ScaleWidth      =   5028
      TabIndex        =   5
      Top             =   0
      Visible         =   0   'False
      Width           =   5028
      Begin CommandButton UpdateButton
         Caption         =   "&Update"
         Height          =   372
         Left            =   960
         TabIndex        =   7
         Top             =   48
         Width           =   1212
      End
      Begin CommandButton CancelButton
         Caption         =   "&Cancel"
         Height          =   372
         Left            =   2640
         TabIndex        =   6
         Top             =   48
         Width           =   1212
      End
   End
   Begin PictureBox StatBox
      Align           =   2  'Align Bottom
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   281
      Left            =   0
      ScaleHeight     =   298.153
      ScaleMode       =   0  'User
      ScaleWidth      =   5665.189
      TabIndex        =   13
      Top             =   3465
      Width           =   5655
      Begin CommandButton NextButton
         Caption         =   ">"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   4200
         TabIndex        =   21
         Top             =   0
         Width           =   375
      End
      Begin CommandButton LastButton
         Caption         =   ">|"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   4575
         TabIndex        =   20
         Top             =   0
         Width           =   375
      End
      Begin CommandButton FirstButton
         Caption         =   "|<"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   0
         TabIndex        =   19
         Top             =   0
         Width           =   375
      End
      Begin CommandButton PrevButton
         Caption         =   "<"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   375
         TabIndex        =   18
         Top             =   0
         Width           =   375
      End
      Begin Label cStatusBar
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   1  'Fixed Single
         Height          =   287
         Left            =   749
         TabIndex        =   14
         Top             =   5
         Width           =   3360
      End
   End
   Begin VScrollBar cScrollBar
      Height          =   2616
      LargeChange     =   3000
      Left            =   5040
      SmallChange     =   300
      TabIndex        =   12
      Top             =   720
      Visible         =   0   'False
      Width           =   252
   End
   Begin PictureBox cFields
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   120
      ScaleHeight     =   372
      ScaleMode       =   0  'User
      ScaleWidth      =   4812
      TabIndex        =   9
      Top             =   720
      Width           =   4815
      Begin TextBox cFieldData
         BackColor       =   &H00FFFFFF&
         DataSource      =   "Data1"
         ForeColor       =   &H00000000&
         Height          =   288
         Index           =   0
         Left            =   1560
         TabIndex        =   10
         Top             =   0
         Visible         =   0   'False
         Width           =   3252
      End
      Begin Label cFieldName
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00000000&
         Height          =   252
         Index           =   0
         Left            =   0
         TabIndex        =   11
         Top             =   60
         Visible         =   0   'False
         Width           =   1572
      End
   End
End
Option Explicit

'form variables
Dim FDS As dynaset            'current form's dynaset
Dim FTblname As String        'form dynaset table name
Dim FBM As String             'form bookmark
Dim FNotFound As Integer      'used by find function
Dim FAtTop As Integer         'top flag
Dim FEditFlag As Integer      'edit mode
Dim FAddNewFlag As Integer    'add mode
Dim FFldDataChanged As Integer
Dim FFindForm As New fFind    'find form instance
Dim FCurrRec As Integer       'record counter
Dim FNumbRows As Long         'total rows in dynaset
Dim FDynaString As String     'dynaset open string

Sub AddButton_Click ()
  On Error GoTo AddErr

  'set the mode
  FDS.AddNew
  cStatusBar = "Add record"
  FAddNewFlag = True
  If FDS.RecordCount > 0 Then
    FBM = FDS.Bookmark
  Else
    FBM = ""
  End If

  ChangeButtons.Visible = True
  ViewButtons.Visible = False
  NextButton.Enabled = False
  FirstButton.Enabled = False
  LastButton.Enabled = False
  PrevButton.Enabled = False

  ClearDataFields
  cFieldData(0).SetFocus
  GoTo AddEnd

AddErr:
  ShowError
  Resume AddEnd

AddEnd:

End Sub

Sub CancelButton_Click ()
   On Error Resume Next

   ChangeButtons.Visible = False
   ViewButtons.Visible = True
   NextButton.Enabled = True
   FirstButton.Enabled = True
   LastButton.Enabled = True
   PrevButton.Enabled = True

   FEditFlag = False
   FAddNewFlag = False
   If FBM <> "" Then FDS.Bookmark = FBM
   DisplayCurrentRecord

End Sub

Sub cFieldData_Change (Index As Integer)
  'just set the flag if data is changed
  'it gets reset to false when a new record is displayed
  FFldDataChanged = True
End Sub

Sub cFieldData_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = &H73 Then   'F4
    'cFieldName_DblClick Index

  ElseIf KeyCode = 34 And cScrollBar.Visible = True Then
    'pagedown with > 10 fields
    cScrollBar = cScrollBar - 3000

  ElseIf KeyCode = 33 And cScrollBar.Visible = True Then
    'pageup with > 10 fields
    cScrollBar = cScrollBar + 3000

  End If
End Sub

Sub cFieldData_KeyPress (Index As Integer, KeyAscii As Integer)
  'only allow return when in edit of add mode
  If FEditFlag = True Or FAddNewFlag = True Then
    If FDS(Index).Type = FT_STRING And Len(cFieldData(Index)) > FDS(Index).Size Then
      Beep
      MsgBox "Field Length Exceeded!", 48
      KeyAscii = 0
      Exit Sub
    End If
    If KeyAscii = 13 Then
      KeyAscii = 0
      SendKeys "{Tab}"
    End If

  'throw away the keystrokes if not in add or edit mode
  ElseIf FEditFlag = False And FAddNewFlag = False Then
    KeyAscii = 0
  End If

End Sub

Sub cFieldData_LostFocus (Index As Integer)
  On Error GoTo FldDataErr

  If FFldDataChanged = True Then
    'store the data in the field
    FDS(Index) = cFieldData(Index)
  End If

  GoTo FldDataEnd

FldDataErr:
  ShowError
  Resume FldDataEnd

FldDataEnd:
  'reset for valid or error condition
  FFldDataChanged = False

End Sub

Sub ClearDataFields ()
  Dim i As Integer

  'clear out the fields on the main form
  For i = 0 To FDS.Fields.Count - 1
    cFieldData(i) = ""
  Next
End Sub

Sub CloseButton_Click ()
  If Not gStoredFlag Then ' this query did not come from storage
    fQuery.RunSaveQryButton.Caption = "&Store Query "
    fQuery.RunSaveQryButton.Enabled = True
    fQuery.RunQueryButton.Enabled = False
    Else
    fQuery.RunSaveQryButton.Caption = "&Load Query"
    fQuery.RunSaveQryButton.Enabled = False
    fQuery.RunQueryButton.Enabled = False
    'gStoredFlag = False
  End If

  fQuery.Show
  Unload Me
End Sub

Sub cScrollBar_Change ()
  Dim t As Integer

  t = cScrollBar
  If (t - 720) Mod 300 = 0 Then
    cFields.Top = t
  Else
    cFields.Top = ((t - 720) \ 300) * 300 + 720
  End If

End Sub

Sub DelButton_Click ()
  On Error GoTo DelRecErr

  If MsgBox("Delete Current Record?", MSGBOX_TYPE) = YES Then
    FDS.Delete
    If gfTransPending Then gfDBChanged = True
    If FDS.EOF = False Then
      FDS.MoveNext
    End If
    FNumbRows = FNumbRows - 1
    DisplayCurrentRecord
  End If

  GoTo DelRecEnd

DelRecErr:
  ShowError
  gstDynaString = ""
  Resume DelRecEnd

DelRecEnd:

End Sub

Sub DisplayCurrentRecord ()
   Dim i As Integer
   Dim cst As String    'current status bar

   On Error GoTo DCRErr

   SetHourGlass Me

   cst = "Record "
   'check BOF/EOF flag so we know if we
   'are sitting on a valid record
   If FAddNewFlag = True Then
     cst = cst + CStr(FCurrRec) + " of " + CStr(FNumbRows)
   Else
     If FDS.BOF = True Then
       cst = cst + "(BOF) of " + CStr(FNumbRows)
       ClearDataFields
     ElseIf FDS.EOF = True Then
       cst = cst + "(EOF) of " + CStr(FNumbRows)
       ClearDataFields
     Else
       cst = cst + CStr(FCurrRec) + " of " + CStr(FNumbRows)
       'place the data in the form fields
       For i = 0 To FDS.Fields.Count - 1
         If FDS(i).Type = FT_MEMO Then
           If FDS(i).FieldSize() < GETCHUNK_CUTOFF Then
             cFieldData(i) = StripNonAscii(vFieldVal(FDS(i)))
           Else
             cFieldData(i) = StripNonAscii(vFieldVal(FDS(i).GetChunk(0, GETCHUNK_CUTOFF)))
           End If
         ElseIf FDS(i).Type = FT_STRING Then
           cFieldData(i) = StripNonAscii(vFieldVal(FDS(i)))
         Else
           cFieldData(i) = vFieldVal(FDS(i))
         End If
       Next
     End If
   End If
   If gfUpdatable = False Then cst = cst + "  [Not Updatable]"
   cStatusBar = cst
   'set the flag
   FFldDataChanged = False

   GoTo DCREnd

DCRErr:
  ShowError
  gstDynaString = ""
  Resume DCREnd

DCREnd:
   ResetMouse Me

End Sub

Sub EditButton_Click ()
   On Error GoTo EditErr

   FDS.Edit
   cStatusBar = "Edit record"
   FEditFlag = True
   cFieldData(0).SetFocus
   FBM = FDS.Bookmark

   ChangeButtons.Visible = True
   ViewButtons.Visible = False
   NextButton.Enabled = False
   FirstButton.Enabled = False
   LastButton.Enabled = False
   PrevButton.Enabled = False

   GoTo EditEnd

EditErr:
  ShowError
  Resume EditEnd

EditEnd:

End Sub

Sub FilterButton_Click ()
  On Error GoTo FilterErr

  Dim bm As String
  Dim ds1 As dynaset, ds2 As dynaset

  Dim i As Integer
  bm = FDS.Bookmark        'save the bookmark
  Set ds1 = FDS            'save the dynaset

    fFIlter.cExpr.Text = ""
    fFIlter.cFieldList.Clear
    For i = 0 To FDS.Fields.Count - 1
      fFIlter.cFieldList.AddItem Mid(cFieldName(i), 1, Len(cFieldName(i)) - 1)
    Next


   MsgBar "Enter Search Parameters", False

  fFIlter.Show MODAL


  'gFilterStr = InputBox("Enter Filter Expression:")
  If gFilterStr = "" Then Exit Sub

  SetHourGlass Me
  MsgBar "Setting New Filter", True
  FDS.Filter = gFilterStr
  Set ds2 = FDS.CreateDynaset()            'establish the filter
  Set FDS = ds2            'assign back to original dynaset object

  'everything must be okay so redisplay form on 1st record
  FNumbRows = GetNumbRecs(FDS)          'query numb of recs
  FCurrRec = 1
  DisplayCurrentRecord     'display field values
  FAtTop = True
  ResetMouse Me
  MsgBar "", False
  GoTo FilterEnd

FilterErr:
  ResetMouse Me
  MsgBar "", False
  ShowError
  Set FDS = ds1            're-assign back to original
  FDS.Bookmark = bm        'go back to original record
  Resume FilterEnd

FilterEnd:

End Sub

Sub FindButton_Click ()
  Dim i As Integer
  Dim bm As String

  On Error GoTo FindErr

  'load the column names into the find form
  If FFindForm.cFieldList.ListCount = 0 Then
    For i = 0 To FDS.Fields.Count - 1
      FFindForm.cFieldList.AddItem Mid(cFieldName(i), 1, Len(cFieldName(i)) - 1)
    Next
  End If

FindStart:

  'reset the flags
  gfFindFailed = False
  gfFromTableView = False
  FNotFound = False

  MsgBar "Enter Search Parameters", False
  FFindForm.Show MODAL
  MsgBar "Searching for New Record", True
  If gfFindFailed = True Then   'find cancelled
    GoTo AfterWhile
  End If

  SetHourGlass Me

   i = FFindForm.cFieldList.ListIndex
   'search for the record
   bm = FDS.Bookmark
   If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then
     FDS.FindFirst FDS(i).Name + " " + gstFindOp + " '" + gstFindExpr + "'"
   Else
     FDS.FindFirst FDS(i).Name + gstFindOp + gstFindExpr
   End If
   FNotFound = FDS.NoMatch

AfterWhile:

   ResetMouse Me

   If gfFindFailed = True Then   'go back to top
     FDS.Bookmark = bm
   ElseIf FNotFound Then
     Beep
     MsgBox "Record Not Found", 48
     FDS.Bookmark = bm
     GoTo FindStart
   Else
     bm = FDS.Bookmark
     FDS.MoveFirst
     FCurrRec = 1
     While FDS.Bookmark <> bm
       FCurrRec = FCurrRec + 1
       FDS.MoveNext
     Wend
   End If

   DisplayCurrentRecord

   GoTo FindEnd

FindErr:
   ResetMouse Me
   If Err <> EOF_ERR Then
     ShowError
     gstDynaString = ""
     Resume FindEnd
   Else
     FNotFound = True
     Resume Next
   End If

FindEnd:
   MsgBar "", False

End Sub

Sub FirstButton_Click ()
   Dim ds As String
   On Error GoTo GoFirstError

   FDS.MoveFirst
   FCurrRec = 1
   DisplayCurrentRecord
   FAtTop = True

   GoTo GoFirstEnd

GoFirstError:
   ShowError
   Resume GoFirstEnd

GoFirstEnd:
   ResetMouse Me
   MsgBar "", False

End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  If FEditFlag = True Or FAddNewFlag = True Then Exit Sub

  Select Case KeyCode
    Case 35                'end
      Call LastButton_Click
    Case 36                'home
      Call FirstButton_Click
    Case 38                'up arrow
      If Shift = 2 Then
        Call FirstButton_Click
      Else
        Call PrevButton_Click
      End If
    Case 40                'down arrow
      If Shift = 2 Then
        Call LastButton_Click
      Else
        Call NextButton_Click
      End If
    Case 114                'F3
      Call FindButton_Click

  End Select

End Sub

Sub Form_Load ()

   Dim t As TableDef       'local table structure
   Dim sp As Integer       'starting point of table name
   Dim ep As Integer       'ending point of table name
   Dim ds As String        'temp dynaset name string
   Dim wh As String        'where clause

   Dim ft As Integer
   Dim i As Integer, j As Integer
   Dim fn As String        'field name
   Dim l As Long


   On Error GoTo DynasetErr

   SetHourGlass Me
   MsgBar "Opening Dynaset", True

   If gfFromSQL = True Then
     ds = fQuery!cCriteria
        If gfFromSQL Then  ' from SQL Statement
            gstDynaString = fQuery!cCriteria ' so we can store
        End If
   Else
       ds = gstDynaString
   End If

   'attemp to open the dynaset
     Set FDS = gCurrentDB.CreateDynaset(ds)
   'parse off table name to store in global gstTblName
   wh = ""
   sp = InStr(1, UCase(ds), "FROM")
   If sp > 0 Then
     'must be a "select from" statement
     sp = sp + 5
     For ep = sp To Len(ds)
       'search for a space or the end of ds
       If Mid$(ds, ep, 1) = " " Then
         'get where clause if there is one
         wh = Mid$(ds, sp, Len(ds) - sp + 1)
         Exit For
       End If
     Next
     FTblname = UCase(Mid$(ds, sp, ep - sp))
     gTblname = FTblname  ' global for filter and sort

     If wh = "" Then wh = FTblname
   Else
     'must be a table name only
     FTblname = UCase(ds)
     wh = FTblname
   End If

   FDynaString = wh

   'show the first record
   FNumbRows = GetNumbRecs(FDS)          'query numb of recs

   'load the controls on the dynaset form
   cFieldName(0).Visible = True
   cFieldData(0).Visible = True
   ft = FDS(0).Type
   cFieldData(0).Width = GetFieldWidth(ft)
   cFieldData(0).TabIndex = 0
   For i = 1 To FDS.Fields.Count - 1
     cFields.Height = cFields.Height + 300
     Load cFieldName(i)
     cFieldName(i).Top = cFieldName(i - 1).Top + 300
     cFieldName(i).Visible = True
     Load cFieldData(i)
     cFieldData(i).Top = cFieldData(i - 1).Top + 300
     cFieldData(i).Visible = True
     ft = FDS.Fields(i).Type
     cFieldData(i).Width = GetFieldWidth(ft)
     cFieldData(i).TabIndex = i
   Next

   'resize main window
   If i <= 10 Then
     Height = ((i + 1) * 300) + 1400
   Else
     Height = 4368
     Width = Width + 260
     cScrollBar.Visible = True
     cScrollBar.Min = 720
     cScrollBar.Max = 720 - (i * 300) + 3000
   End If

   'display the field names
   For i = 0 To FDS.Fields.Count - 1
     cFieldName(i) = UCase(FDS(i).Name) + ":"
   Next

   FCurrRec = 1
   DisplayCurrentRecord      'display field values
   FAtTop = True
     '
     Caption = "Dynaset: " + FTblname

   Me.Left = (screen.Width - Me.Width) / 2
   Me.Top = (screen.Height - Me.Height) / 2

   'Width = 5805
   'Left = 1000
   'Top = 1000
     Me.Show
     fQuery.Hide

   GoTo OkayEnd

DynasetErr:
   ShowError
   ResetMouse Me
   gstDynaString = ""
   Unload Me
   fQuery.Show
   MsgBar "", False
   Exit Sub
   Resume OkayEnd

OkayEnd:
   ResetMouse Me
   MsgBar "", False

End Sub

Sub Form_Paint ()

  Outlines Me
End Sub

Sub Form_Resize ()
  On Error Resume Next

  Dim h As Integer, i As Integer
  Dim totw As Integer

  If WindowState <> 1 Then   'not minimized
    MsgBar "Resizing Form", True
    'make sure the form is lined up on a field
    h = Height
    If (h - 1420) Mod 300 <> 0 Then
      Height = ((h - 1420) \ 300) * 300 + 1420
    End If
    'resize the status bar
    StatBox.Top = Height - 650
    'resize the scrollbar
    cScrollBar.Height = StatBox.Top - (ViewButtons.Top - FieldHeader.Height) - 960
    cScrollBar.Left = Width - 360
    If FDS.Fields.Count > 10 Then
      cFields.Width = Width - 260
      totw = cScrollBar.Left - 20
    Else
      cFields.Width = Width - 20
      totw = Width - 50
    End If
    FieldHeader.Width = Width - 20
    'widen the fields if possible
    For i = 0 To FDS.Fields.Count - 1
      cFieldName(i).Width = .3 * totw
      cFieldData(i).Left = cFieldName(i).Width + 20
      If FDS(i).Type = FT_STRING Or FDS(i).Type = FT_MEMO Then
        cFieldData(i).Width = .7 * totw - 250
      End If
    Next
    'FieldValueLabel.Left = cFieldData(0).Left
    cStatusBar.Width = Width - 1600
    NextButton.Left = cStatusBar.Width + 745
    LastButton.Left = NextButton.Left + 370
  End If
  MsgBar "", False
End Sub

Sub Form_Unload (Cancel As Integer)
  On Error Resume Next
  'gstDynaString = ""
  Unload FFindForm
  'get rid of attached find form
  FDS.Close          'close the form dynaset
  MsgBar "", False
End Sub

Sub LastButton_Click ()
   On Error GoTo GoLastError

   FDS.MoveLast
   'show the current record
   FCurrRec = FNumbRows
   DisplayCurrentRecord

   GoTo GoLastEnd

GoLastError:
   ShowError
   Resume GoLastEnd

GoLastEnd:

End Sub

Sub NextButton_Click ()
   On Error GoTo GoNextError

   FDS.MoveNext
   'show the current record
   FCurrRec = FCurrRec + 1   'bump the record counter
   DisplayCurrentRecord
   FAtTop = False

   GoTo GoNextEnd

GoNextError:
   ShowError
   Resume GoNextEnd

GoNextEnd:

End Sub

Sub PrevButton_Click ()
   On Error GoTo GoPrevError

   FDS.MovePrevious
   'show the current record
   FCurrRec = FCurrRec - 1   'bump the record counter back
   DisplayCurrentRecord
   FAtTop = False

   GoTo GoPrevEnd

GoPrevError:
   ShowError
   Resume GoPrevEnd

GoPrevEnd:

End Sub

Sub SortButton_Click ()
  On Error GoTo SortErr

  Dim bm As String
  Dim ds1 As dynaset, ds2 As dynaset

  Dim i As Integer
  gSortStr = ""

  bm = FDS.Bookmark        'save the bookmark
  Set ds1 = FDS            'save the dynaset


    fSort.cFieldList.Clear
    For i = 0 To FDS.Fields.Count - 1
      fSort.cFieldList.AddItem Mid(cFieldName(i), 1, Len(cFieldName(i)) - 1)
    Next


  fSort.Show MODAL
  'gSortStr = InputBox("Enter Sort Column:")
  If gSortStr = "" Then Exit Sub

  SetHourGlass Me
  MsgBar "Setting New Sort Order", True
  FDS.Sort = gSortStr
  Set ds2 = FDS.CreateDynaset()            'establish the Sort
  Set FDS = ds2            'assign back to original dynaset object

  'everything must be okay so redisplay form on 1st record
  FNumbRows = GetNumbRecs(FDS)          'query numb of recs
  FCurrRec = 1
  DisplayCurrentRecord     'display field values
  FAtTop = True
  ResetMouse Me
  MsgBar "", False
  GoTo SortEnd

SortErr:
  ResetMouse Me
  MsgBar "", False
  ShowError
  Set FDS = ds1            're-assign back to original
  FDS.Bookmark = bm        'go back to original record
  Resume SortEnd

SortEnd:

End Sub

Sub UpdateButton_Click ()
  On Error GoTo UpdateErr

  FDS.Update
  If gfTransPending Then gfDBChanged = True

  If FAddNewFlag = True Then
    FNumbRows = FNumbRows + 1
    FCurrRec = FNumbRows
    FDS.MoveLast             'move to the new record
  End If

  ChangeButtons.Visible = False
  ViewButtons.Visible = True
  NextButton.Enabled = True
  FirstButton.Enabled = True
  LastButton.Enabled = True
  PrevButton.Enabled = True
  FEditFlag = False
  FAddNewFlag = False
  DisplayCurrentRecord

  GoTo UpdateEnd

UpdateErr:
  ShowError
  Resume UpdateEnd

UpdateEnd:

End Sub